home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / feel0_89.lha / Feel / Libs / CSP / csp-phil.em next >
Encoding:
Text File  |  1993-07-18  |  4.6 KB  |  165 lines
  1. ;; yep. Philosophers in CSP
  2.  
  3. (defmodule csp-phil 
  4.   ((rename ((binary-plus +)
  5.         (binary-times *)
  6.         (binary-difference -)
  7.         (binary-gt >)
  8.         (binary-lt <))
  9.        (except (+ * - > <)standard0))
  10.    list-fns
  11.    loopsII
  12.    driver
  13.    csp) ()
  14.  
  15. ;;  int num-phils = 5
  16. ;;  
  17. ;;  CHAN l-chans[num-phils]
  18. ;;  CHAN r-chans[num-phils]
  19. ;;
  20. ;;  PROC phil (l-chan r-chan i)
  21. ;;    int x
  22. ;;    WHILE TRUE
  23. ;;      DO go-in(i)
  24. ;;      "req" ! l-chan
  25. ;;      "req" ! r-chan
  26. ;;      ALT 
  27. ;;        x ? l-chan -> x ? rchan
  28. ;;    x ? r-chan -> x ? l-chan
  29. ;;      DO eat(i)
  30. ;;        "free" ! l-chan
  31. ;;    "free" ! r-chan
  32. ;;      DO leave(i)
  33. ;;    END
  34. ;;
  35. ;;  PROC fork (l-chan r-chan)
  36. ;;   int x
  37. ;;   WHILE TRUE
  38. ;;     ALT
  39. ;;       x ? l-chan SEQ ok ! l-chan
  40. ;;              x ? l-chan
  41. ;;       x ? r-chan SEQ ok ! r-chan
  42. ;;                      x ? r-chan
  43. ;;  END                      
  44. ;;         
  45. ;;  FOR i = 1 num-phils-1
  46. ;;    PAR 
  47. ;;      phil(l-chans[i],r-chans[i])
  48. ;;      fork(l-chans[i],r-chans[i])
  49. ;;    END
  50. ;;  END       
  51.  
  52.  
  53.   (plot-string X-stream 155 495 "Dining Philosophers in CSP")
  54.  
  55.   (read-pixmap X-stream "phil.xbm") ;; Philosopher
  56.   (read-pixmap X-stream "thinks.xbm") ;; Idea
  57.   (read-pixmap X-stream "sticks.xbm") ;; Chops
  58.   (read-pixmap X-stream "ticket.xbm") 
  59.   (read-pixmap X-stream "bulb.xbm") 
  60.  
  61.   (deflocal *think-level* 360)
  62.   (deflocal *eat-level* 140)
  63.   (deflocal *margin* 50)
  64.   (deflocal *space* 80)
  65.  
  66.   (defun philosophize (i lchan rchan doorchan)
  67.     (let ((x nil))
  68.       (SEQ (enter i doorchan)
  69.        ;;(format t "Phil: ~a gets in\n" i)       
  70.        (SEQ (OUT rchan 'req)
  71.         (OUT lchan 'req))
  72.        (eat i)
  73.        (SEQ (OUT rchan 'free)
  74.         (OUT lchan 'free))
  75.        (leave i doorchan)))
  76.     (philosophize i lchan rchan doorchan))
  77.  
  78.   (defun enter (i doorchan)
  79.     ;;(format t "Phil: ~a gets to the door\n" i)
  80.     (OUT doorchan 'enter)
  81.     (unplot X-stream 1 (+ *margin* (* i *space*)) (- *think-level* 40))
  82.     (plot X-stream 4 (+ *margin* (* i *space*)) (- *think-level* 40))
  83.     (let ((x (IN doorchan)))
  84.       (unplot X-stream 4 (+ *margin* (* i *space*)) (- *think-level* 40))
  85.       (plot X-stream 3 (+ *margin* (* i *space*)) (+ *eat-level* 40))
  86.       (move X-stream i (+ *margin* (* i *space*)) *eat-level*)))
  87.  
  88.   (defun init-phil (i)
  89.         (manage X-stream 0)
  90.     (move X-stream i (+ *margin* (* i *space*))
  91.           *think-level*)
  92.     (plot X-stream 1 (+ *margin* (* i *space*)) 
  93.           (- *think-level* 40)))
  94.  
  95.   (defun leave (i doorchan)
  96.     ;;(format t "Phil: ~a Leaves\n" i)    
  97.     (unplot X-stream 2 (+ *margin* (* i *space*))
  98.         (- *eat-level* 40))
  99.     (OUT doorchan 'leave)
  100.     (unplot X-stream 3 (+ *margin* (* i *space*)) (+ *eat-level* 40))
  101.     (move X-stream i (+ *margin* (* i *space*)) *think-level*)
  102.     (plot X-stream 1 (+ *margin* (* i *space*)) (- *think-level* 40)))
  103.  
  104.  
  105.   (defun eat (i)
  106.     ;;(format t "Phil: ~a Eats\n" i)    
  107.     (plot X-stream 2 (+ *margin* (* i *space*)) (- *eat-level* 40)))
  108.  
  109.   (defun doorman (chans n-phil)
  110.     (doorman-aux nil (convert chans pair)  0 n-phil))
  111.  
  112.   (defun doorman-aux (ready-chans live-chans i n-phil)
  113.     (IN-FROM (chan req) live-chans 
  114.        (cond ((eq req 'enter)
  115.           (cond ((= i (- n-phil 1))
  116.              (format t "**Problems..\n")
  117.              (doorman-aux (cons chan ready-chans)
  118.                   (deleteq chan live-chans)
  119.                   i n-phil))
  120.             ;; no problem...
  121.             (t (OUT chan 'ok)
  122.                (doorman-aux ready-chans live-chans (+ i 1) n-phil))))
  123.          ((eq req 'leave)
  124.           (cond (ready-chans
  125.              (OUT (car ready-chans) 'ok)
  126.              (doorman-aux (cdr ready-chans) 
  127.                   (cons (car ready-chans)
  128.                     live-chans)
  129.                   i n-phil))
  130.             (t
  131.              (doorman-aux ready-chans live-chans
  132.                   (- i 1) n-phil)))))))
  133.         
  134.   ;; forks...
  135.   (defun fork-task (lchan rchan)
  136.     (let ((dummy nil))
  137.       (ALT ((IN lchan dummy)
  138.         (IN lchan dummy))
  139.        ((IN rchan dummy)
  140.         (IN rchan dummy))))
  141.     (fork-task lchan rchan))
  142.      
  143.   (defun doit (n)
  144.     (let ((left-channels (mapvect make-Chan-Pair (make-vector n)))
  145.       (right-channels (mapvect make-Chan-Pair (make-vector n)))
  146.       (doorman-chans (mapcar make-Chan-Pair (consn n))))
  147.       (PAR (FOR (i 0) (< i n) (++ i)
  148.         (SEQ (format t "Phil ~a starting~%" i)
  149.              (init-phil i)
  150.              (philosophize i
  151.                    (connect-chan-pair (vector-ref left-channels i))
  152.                    (connect-chan-pair (vector-ref right-channels i))
  153.                    (connect-chan-pair (nth i doorman-chans)))))
  154.        (FOR (i 0) (< i n) (++ i)
  155.         (SEQ (format t "Fork: ~a starting~%" i)
  156.              (fork-task (connect-chan-pair (vector-ref left-channels i))
  157.                 (connect-chan-pair (vector-ref right-channels
  158.                                    (remainder (+ i 1) n))))))
  159.        (SEQ (format t "Doorman starting\n")
  160.         (doorman (mapcar connect-chan-pair doorman-chans) n)))))
  161.   
  162. )      
  163.  
  164.  
  165.